#!/usr/bin/perl
# =================================================================
# Begin cut to include XNAT tools Perl libraries
# =================================================================
my ($prog,$progdir);
BEGIN {
  if($0 =~ m{(.*)/(.*?)$}) {
    ($progdir,$prog) = ($1,$2);
  } else {
    ($progdir,$prog) = ($0,'');
  }
  $progdir = '.' unless $progdir;
  push @INC, "$progdir/lib", "$progdir";
  #print join(':',@INC),"\n";
}
# =================================================================
# End cut to include XNAT tools Perl libraries
# =================================================================
use strict;
use Getopt::Long qw(:config no_ignore_case);
use Time::HiRes qw( gettimeofday tv_interval );

sub usage {
	<<"EOF";
Usage:
  # Generate a random subject_id/session_id to use for PatientsName, etc.
$prog --randid dicom1 dicom2 ...
  # Use the given id, not a random one
$prog --id SOME_ID dicom1 dicom2 ...

Use one or more -v to increase verbosity.
EOF
}

my $err = "";
my $subject_tags = {};
my @r = qw(A B C D E F G H J K L M N P Q R S T U V W X Y Z 2 3 4 5 6 7 8 9 );
my $opts = {investigator=>'UNKOWN'};

GetOptions($opts,
	   'randid',
	   'id=s',
	   'v+',
	   'investigator=s',
          )
  || die &usage, "ERROR: Did not understand command line options.\n";

if($opts->{id} && $opts->{randid}) {
	die &usage, "ERROR: You can only specify --id or --randid, not both!\n";
}
if(! $opts->{id} && !$opts->{randid}) {
	die &usage, "ERROR: You must specify --id or --randid!\n";
}

my $erase_tags =
	{
	 '0008,0090' => 'ReferringPhysiciansName',
	 '0010,21b0' => 'AdditionalPatientHistory',
	 '0032,1030' => 'ReasonForStudy',
	 '0032,1032' => 'RequestingPhysician',
	 '0038,0300' => 'CurrentPatientLocation',
#	 '0010,1040' => 'PatientsAddress',
	};
my $erase = "";
foreach my $tag (keys %{$erase_tags}) {
	$erase .= " -ma \"($tag)=\"";
}

if ( ! $ENV{DCMDICTPATH} || ( $ENV{DCMDICTPATH} && -e $ENV{DCMDICTPATH} ) ) {
  if ( $ENV{DCMDICTPATH} ) {
		print "WARNING: Environment variable \$DCMDICTPATH is set to '$ENV{DCMDICTPATH}', which does not exist.\n";
		print "WARNING: Will attempt to find the dicom.dic file for you.\n";
	}
	my $ok = 0;
	foreach( '/usr/share/dcmtk/dicom.dic', '/usr/local/dicom/lib/dicom.dic' , "$ENV{HOME}/dicom.dic", '/ncf/tools/nrg/DCMTK/lib/dicom.dic' ) {
		if(-e $_) {
			$ENV{DCMDICTPATH} = $_;
			$ok = 1;
			last;
		}
	}
	if(! $ok) {
		die "ERROR: Unable to locate dicom.dic file. Please set the \$DCMDICTPATH environment variable to the full path and filename of the dicom.dic file.\n";
	}
}

chomp (my $dcm2xml = `which dcm2xml`);
chomp (my $dcmodify = `which dcmodify`);

if( ! $dcm2xml ) {
	$err .= "ERROR: Could not find dcm2xml in path. Please fix.\n";
} elsif ( ! -x $dcm2xml ) {
	$err .= "ERROR: dcm2xml in path ($dcm2xml) is not executable. Please fix.\n";
}

if( ! $dcmodify ) {
	$err .= "ERROR: Could not find dcmodify in path. Please fix.\n";
} elsif ( ! -x $dcmodify ) {
	$err .= "ERROR: dcmodify in path ($dcmodify) is not executable. Please fix.\n";
}

if(!@ARGV || $err) {
	die "$err\nUsage: $0 dicom1 dicom2 dicom3 ...\n";
}

foreach my $dicom (@ARGV) {
	die "DICOM File '$dicom' does not exist! " unless -e $dicom;
	die "DICOM File '$dicom' is not readable! " unless -r $dicom;
	die "DICOM File '$dicom' is not writable! " unless -w $dicom;
	print "Scrubbing '$dicom':";# if $opts->{v} > 1;
	open(XML, "$dcm2xml '$dicom' |") || die "ERROR: Failed to run $dcm2xml '$dicom'!\nREASON: $!\n";
	my $xml = join('',<XML>);
	close(XML);
	my $modify = "";
	my $date = "";
	my $StudyInstanceUID = "";
	my $PatientsBirthDate = "";
	my $PatientsBirthDateTag = "";
	my $PatientsNewBirthDate = "";
	my $PatientsAddress = "";
	my $PatientsAddressTag = "";
	my $PatientsName = "";
	my $PatientsNameTag = "";
	# =================================================================
	# Check PatientsBirthDate
	# =================================================================
	if ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="PatientsBirthDate">([0-9]+)</element>}) {
		($PatientsBirthDateTag,$PatientsBirthDate) = ($1,$2);
		if($PatientsBirthDate =~ m/^(\d\d\d\d)\d\d\d\d/) {
			$PatientsNewBirthDate = $1."0101";
			if($PatientsBirthDate ne $PatientsNewBirthDate) {
				print " PatientsBirthDate:'$PatientsBirthDate'=>'$PatientsNewBirthDate'" if $opts->{v} > 1;
				$modify .= " -ma \"($PatientsBirthDateTag)=$PatientsNewBirthDate\"";
			}
		} else {
			warn "WARNING: Don't understand PatientsBirthDate = '$PatientsBirthDate'!\n";
		}
	} else {
		die "ERROR: Unable to get PatientsBirthDate from '$dicom'!\n";
	}
	# =================================================================
	# Get Scan Date
	# =================================================================
	if ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="AcquisitionDate">([0-9]+)</element>}) {
		$date = $2;
	} elsif ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="SeriesDate">([0-9]+)</element>}) {
		$date = $2;
	} elsif ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="StudyDate">([0-9]+)</element>}) {
		$date = $2;
	} else {
		die "ERROR: Unable to get a study/series/acquitition date from '$dicom'!\n";
	}
	# =================================================================
	# Get StudyInstanceUID
	# =================================================================
	if ($xml =~ m{<element[^>]+tag="[0-9,a-f]+"[^>]+name="StudyInstanceUID">([^>]+)</element>}) {
		$StudyInstanceUID = $1;
	} else {
		die "ERROR: Unable to get StudyInstanceUID from '$dicom'!\n";
	}
	if(! $subject_tags->{$StudyInstanceUID}) {
		if($opts->{randid}) {
			$subject_tags->{$StudyInstanceUID} = $date."_".$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))].$r[int(rand(@r))];
		} else {
			$subject_tags->{$StudyInstanceUID} = $opts->{id};
		}
	}
	my $subtag=$subject_tags->{$StudyInstanceUID};
	print " ($subtag)" unless $opts->{v};

	# =================================================================
	# Check PatientsAddress
	# =================================================================
	if ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="PatientsAddress">([^>]*)</element>}) {
		($PatientsAddressTag,$PatientsAddress) = ($1,$2);
		if($PatientsAddress) {
			print " PatientsAddress:'$PatientsAddress'=>''" if $opts->{v} > 1;
			$modify .= " -ma \"($PatientsAddressTag)=\"";
		}
	} else {
		die "WARN: Unable to get PatientsAddress from '$dicom'!\n" if $opts->{v} > 1;
	}
	# =================================================================
	# Check PatientsName
	# =================================================================
	if ($xml =~ m{<element[^>]+tag="([0-9,a-f]+)"[^>]+name="PatientsName">([^>]+)</element>}) {
		($PatientsNameTag,$PatientsName) = ($1,$2);
		print " PatientsName:'$PatientsName'=>'$subtag'" if $opts->{v} > 1;
	} else {
		warn "WARNING: Unable to get PatientsName from '$dicom', strange, but not an issue.\n";
	}

	if($PatientsName =~ m/^[0-9]/) {
		warn "WARNING: '$dicom' looks like it already has a scrubbed PatientsName '$PatientsName', skipping.\n" if $opts->{v} > 1;
	} else {
		$modify .= " -ma \"($PatientsNameTag)=$subtag\" -ma \"(0010,0020)=$subtag\" -ma \"(0008,0050)=$subtag\"";
	}


	print "\n" if $opts->{v} > 1;

	if($modify) {
		my $cmd = "$dcmodify -ie $modify $erase '$dicom'";
		print "Running: $cmd" if $opts->{v} > 0;
		if( 0 == system("$cmd > /dev/null 2> /dev/null ") ) {
			print " OK!\n" if $opts->{v} > 0;
		} else {
			die "ERROR! Failed to run $cmd\n";
		}
	} else {
		print "'$dicom' already scrubbed.\n";
	}
	print " OK\n" unless $opts->{v};

}



__END__
